home *** CD-ROM | disk | FTP | other *** search
/ New Star Software Collection / NSS_Collection.iso / 5-023 bas2com basic compiler / 1.img / DEMO.BAS < prev    next >
BASIC Source File  |  1982-05-07  |  7KB  |  173 lines
  1. 1000 '  IBM Personal Computer BASIC Compiler Demonstration Program
  2. 1010 '  Version 1.00 (C)Copyright IBM Corp 1982
  3. 1015 '  Licensed Material - Program Property of IBM
  4. 1020 '
  5. 1030 ON ERROR GOTO 2680
  6. 1040 HIGH=0:NM$="BASCOM"
  7. 1050 DEFINT A-Z
  8. 1060 DIM S.STAT(20),S.X(20),S.Y(20),S.SP(20),S.PAT(20),S.PIC$(20,1),S.SCORE(20)
  9. 1070 DIM S.LEN(20),BUL(80),SND$(5)
  10. 1080 DIM B.X(20),B.Y(20),B.ACT(20)
  11. 1090 DIM N.PIC$(10,1),N.SCORE(10),N.SP(10),N.LEN(10)
  12. 1100 DIM X.TOP$(6),X.BOT$(6)
  13. 1110 WIDTH 80:WD=80
  14. 1120 KEY OFF : COLOR 7,0,0 : CLS
  15. 1130 IF WD=80 THEN SCREEN 0,1:LOCATE ,,0
  16. 1140 M$="IBM Personal Computer" : Y=8 : GOSUB 2670
  17. 1150 M$="BASIC Compiler" : Y=10 : GOSUB 2670
  18. 1160 M$="Demonstration Program" : Y=12 : GOSUB 2670
  19. 1170 M$="Do you have a color monitor (Y/N)? " : Y=16 : GOSUB 2670
  20. 1180 A$=INKEY$:IF A$="" THEN GOTO 1180
  21. 1190 IF A$="Y" OR A$="y" THEN CLR=1:GOTO 1230
  22. 1200 IF A$="n" OR A$="N" THEN CLR=0:GOTO 1230
  23. 1210 IF A$=CHR$(3) THEN END
  24. 1220 GOTO 1180
  25. 1230 '
  26. 1240 '
  27. 1250 '      Target Program
  28. 1260 '
  29. 1270 CLS
  30. 1280 M$="TTTTT   AAA   RRRR    GGGG  EEEEE  TTTTT" : Y=4 : GOSUB 2670
  31. 1290 M$="  T    A   A  R   R  G      E        T  " : Y=5 : GOSUB 2670
  32. 1300 M$="  T    A   A  R   R  G      E        T  " : Y=6 : GOSUB 2670
  33. 1310 M$="  T    AAAAA  RRRR   G  GG  EEE      T  " : Y=7 : GOSUB 2670
  34. 1320 M$="  T    A   A  R R    G   G  E        T  " : Y=8 : GOSUB 2670
  35. 1330 M$="  T    A   A  R  R   G   G  E        T  " : Y=9 : GOSUB 2670
  36. 1340 M$="  T    A   A  R   R   GGGG  EEEEE    T  " : Y=10: GOSUB 2670
  37. 1350 LOCATE 13,1 : PRINT "Instructions:" : PRINT
  38. 1360 PRINT "Press space bar   to fire"
  39. 1370 PRINT "Press left  arrow to move left"
  40. 1380 PRINT "Press right arrow to move right"
  41. 1390 PRINT "Press ESC         to return to menu"
  42. 1400 PRINT "Press Ctrl-Break  to exit the program"
  43. 1410 PRINT : PRINT "NOTE - Only 1 shell per position"
  44. 1420 PRINT : PRINT "Press any key to continue"
  45. 1430 A$=INKEY$:IF A$="" THEN 1430
  46. 1440 IF A$=CHR$(3) THEN SCREEN 0,0,0:END
  47. 1450 NL = 24 : WIDTH WD :LOCATE ,,0
  48. 1460 IF CLR THEN COLOR 7,1,1
  49. 1470 CLS
  50. 1480 M.S=12
  51. 1490 M.B=12
  52. 1500 M.N=5 : GOSUB 2550
  53. 1510 FOR I=1 TO 5
  54. 1520   X.TOP$(I)="\"+STRING$(I,"|")+"/" : X.BOT$(I)="/"+STRING$(I,"|")+"\"
  55. 1530   IF A=3 THEN END
  56. 1540 NEXT I
  57. 1550 BULLIT$=CHR$(127)
  58. 1560 PLAY "mbt255l32"
  59. 1570 LOCATE 25,1 : IF WD=80 THEN PRINT "IBM Personal Computer ";
  60. 1580 PRINT "Basic Compiler Demo"; :
  61. 1590 M$="(ESC to restart)" : LOCATE 25,WD-LEN(M$) : PRINT M$;
  62. 1600 D.T=12: M.T=(WD-5)*D.T-1
  63. 1610 LOCATE NL-1,3 : PRINT STRING$(WD-5,BULLIT$);
  64. 1620 FOR I=3 TO WD-3 : BUL(I)=1 : NEXT : NB=WD-5
  65. 1630 FOR I=2 TO NL-1
  66. 1640   LOCATE I,1 : PRINT CHR$(186); : LOCATE I,WD-1 : PRINT CHR$(186);
  67. 1650 NEXT
  68. 1660 LOCATE 1,1 : PRINT CHR$(201);STRING$(WD-3,205);CHR$(187);
  69. 1670 LOCATE NL,1 : PRINT CHR$(200);STRING$(WD-3,205);CHR$(188);
  70. 1680 LOCATE NL-2,1 : PRINT CHR$(199);STRING$(WD-3,196);CHR$(182);
  71. 1690 BX=WD\2 : LOCATE NL-2,BX : PRINT CHR$(208);
  72. 1700 LOCATE 1,8*(WD/40):PRINT " SCORE = ";SCORE:LOCATE 1,26*(WD/40):PRINT " TIME LEFT";(899-C.T)\10
  73. 1710 FOR C.T=1 TO M.T
  74. 1720   FOR I=3 TO M.S
  75. 1730     ON S.STAT(I)+1 GOTO 1740,1800,1930,1960,2080,2120
  76. 1740     ' Inactive
  77. 1750     IF RND>.17 THEN 2190
  78. 1760     J=4*RND
  79. 1770     S.STAT(I)=1 : S.X(I)=3 : S.Y(I)=I : S.SP(I)=N.SP(J) : S.PAT(I)=0
  80. 1780     S.PIC$(I,0)=N.PIC$(J,0):S.PIC$(I,1)=N.PIC$(J,1) : S.SCORE(I)=N.SCORE(J)
  81. 1790     S.LEN(I)=N.LEN(J):LOCATE S.Y(I),S.X(I)-1:PRINT S.PIC$(I,0); : GOTO 2190
  82. 1800     ' Fly
  83. 1810     X1=S.X(I) : Y=S.Y(I) : X2=S.X(I)+S.LEN(I)
  84. 1820     IF C.T AND S.SP(I) THEN X2=X2-1 : GOTO 1860
  85. 1830     LOCATE S.Y(I),X1
  86. 1840     PRINT S.PIC$(I,S.PAT(I)); : X1=X1+1 : S.X(I)=X1
  87. 1850     S.PAT(I)=1-S.PAT(I) : IF X1=WD-7 THEN S.STAT(I)=2
  88. 1860     FOR J=0 TO M.B
  89. 1870       IF B.ACT(J)=0 THEN 1910
  90. 1880       IF B.Y(J)<>Y THEN 1910
  91. 1890       IF B.X(J)>=X1 THEN IF B.X(J)<=X2 THEN 1900 ELSE 1910 ELSE 1910
  92. 1900       S.STAT(I)=3 : B.ACT(J)=0 : SCORE=SCORE+S.SCORE(I)
  93. 1910     NEXT J
  94. 1920     GOTO 2190
  95. 1930     ' Final
  96. 1940     LOCATE S.Y(I),S.X(I) : PRINT "      "; : S.STAT(I)=0
  97. 1950     GOTO 2190
  98. 1960     ' Hit
  99. 1970     PLAY SND$(S.LEN(I)-1)
  100. 1980     X=S.X(I) : Y=S.Y(I) : LN=S.LEN(I)
  101. 1990     IF CLR THEN COLOR 4
  102. 2000     LOCATE Y-1,X-1 : PRINT X.TOP$(LN);
  103. 2010     LOCATE Y,X-1 : PRINT "-";
  104. 2020     LOCATE Y,X+LN : PRINT "-";
  105. 2030     LOCATE Y+1,X-1 : PRINT X.BOT$(LN);
  106. 2040     IF CLR THEN COLOR 7
  107. 2050     S.STAT(I)=4
  108. 2060     LOCATE 1,8*(WD/40):PRINT " SCORE = ";SCORE
  109. 2070     GOTO 2190
  110. 2080     ' Blown
  111. 2090     LOCATE S.Y(I),S.X(I) : PRINT SPC(S.LEN(I));
  112. 2100     S.STAT(I)=5
  113. 2110     GOTO 2190
  114. 2120     ' Down
  115. 2130     X=S.X(I) : Y=S.Y(I) : LN=S.LEN(I)+2
  116. 2140     LOCATE Y-1,X-1 : PRINT SPC(LN);
  117. 2150     LOCATE Y,X-1 : PRINT SPC(LN);
  118. 2160     LOCATE Y+1,X-1 : PRINT SPC(LN);
  119. 2170     S.STAT(I)=0
  120. 2180     GOTO 2190
  121. 2190   NEXT I
  122. 2200   FOR I=0 TO M.B
  123. 2210     IF B.ACT(I)=0 THEN 2250
  124. 2220     IF B.Y(I)=NL-2 THEN 2240
  125. 2230     LOCATE B.Y(I),B.X(I):PRINT " ";:IF B.Y(I)=2 THEN B.ACT(I)=0:GOTO 2350
  126. 2240     B.Y(I)=B.Y(I)-1 : LOCATE B.Y(I),B.X(I) : PRINT BULLIT$; : GOTO 2350
  127. 2250     A$=INKEY$ : IF LEN(A$)=0 THEN 2350
  128. 2260     A=ASC(A$) : IF A<>32 THEN IF A=3 THEN SCREEN 0,0,0:COLOR 7,0:END ELSE GOTO 2300
  129. 2270     IF BUL(BX)=0 THEN 2300
  130. 2280     BUL(BX)=0 : B.X(I)=BX : B.Y(I)=NL-2 : B.ACT(I)=1:NB=NB-1
  131. 2290     LOCATE NL-1,BX : PRINT " "; : PLAY "N35"
  132. 2300 '
  133. 2310     IF A=0 THEN A=ASC(MID$(A$,2))-23
  134. 2320     IF A=52 AND BX>3 THEN BX=BX-1 : LOCATE NL-2,BX : PRINT CHR$(208);CHR$(196); : GOTO 2350
  135. 2330     IF A=54 AND BX<WD-3 THEN LOCATE NL-2, BX : BX=BX+1 : PRINT CHR$(196);CHR$(208);
  136. 2340     IF A=27 THEN SCORE = 0:GOTO 1270
  137. 2350   NEXT I
  138. 2360 IF NB<>0 THEN GOTO 2390
  139. 2370 NB=WD-5:FOR I=3 TO WD-3:BUL(I)=1:NEXT
  140. 2380 LOCATE NL-1,3:PRINT STRING$(WD-5,BULLIT$);
  141. 2390 LOCATE 1,26*(WD/40):PRINT " TIME LEFT";(899-C.T)\10:NEXT  C.T
  142. 2400 FOR I=0 TO M.B
  143. 2410 B.Y(I)=2
  144. 2420 NEXT I
  145. 2430 CLS:LOCATE 10,16*(WD/40):PRINT "YOUR SCORE WAS ";SCORE
  146. 2440 IF SCORE<=HIGH THEN GOTO 2470
  147. 2450 HIGH=SCORE:LOCATE 11,10*(WD/40):PRINT "CONGRATULATIONS! THAT'S THE NEW HIGH SCORE!"
  148. 2460 LOCATE 15,15*(WD/40):INPUT "TYPE IN YOUR NAME-",NM$:FOR I=1 TO 20000:NEXT:CLS:SCORE=0:GOTO 1610
  149. 2470 LOCATE 12,17*(WD/40):PRINT "NICE TRY, BUT "
  150. 2480 BEGN=WD/2-LEN(NM$)/2:LOCATE 14,BEGN:PRINT NM$:SCORE=0
  151. 2490 LOCATE 16,13*(WD/40):PRINT "STILL HAS THE HIGH SCORE -";HIGH
  152. 2500 LOCATE 25,30:PRINT "HIT ENTER TO CONTINUE"
  153. 2510 A$=INKEY$:IF A$="" THEN GOTO 2510
  154. 2520 IF A$=CHR$(13) THEN CLS:GOTO 1610
  155. 2530 IF A$=CHR$(3) THEN SCREEN 0,0,0:COLOR 7,0:END
  156. 2540 GOTO 2510
  157. 2550 N.PIC$(0,0)=" *"     : N.PIC$(0,1)=" +"     : N.SCORE(0)=30 : N.SP(0)=0
  158. 2560 N.PIC$(1,0)=" **"    : N.PIC$(1,1)=" ++"    : N.SCORE(1)=20 : N.SP(1)=1
  159. 2570 N.PIC$(2,0)=" ***"   : N.PIC$(2,1)=" +++"   : N.SCORE(2)=15 : N.SP(2)=1
  160. 2580 N.PIC$(3,0)=" ****"  : N.PIC$(3,1)=" ++++"  : N.SCORE(3)=10 : N.SP(3)=3
  161. 2590 N.PIC$(4,0)=" *****" : N.PIC$(4,1)=" +++++" : N.SCORE(4)= 5 : N.SP(4)=7
  162. 2600 FOR I=0 TO 10 : N.LEN(I)=I+1 : NEXT
  163. 2610 SND$(0)="N65N56"
  164. 2620 SND$(1)="N37N47N33"
  165. 2630 SND$(2)="n37N28N35"
  166. 2640 SND$(3)="N45N35N55N35"
  167. 2650 SND$(4)="N55N35N45N65"
  168. 2660 RETURN
  169. 2670 LOCATE Y,(WD-LEN(M$)+2)\2 : PRINT M$; : RETURN
  170. 2680 IF ERR=51 THEN PRINT "INTERNAL ERROR":BEEP:END
  171. 2690 PRINT "ERROR ";ERR;" ON LINE ";ERL:END
  172. )+2)\2 : PRINT M$; : RETURN
  173. 2680 IF ERR=51 THEN PRINT "INTERNAL ERROR":BEEP:END